home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1996 February / macformat-034.iso / mac / Shareware City / Applications / NIH Image 1.59 / Macros / FFT Macros < prev    next >
Encoding:
Text File  |  1995-10-11  |  7.0 KB  |  326 lines  |  [TEXT/Imag]
  1. var  {global }
  2.    FilterSize: real; {0-100% of image size}
  3.    TransitionWidth: real; {0-100% of filter radius}
  4.     PlotFilter: boolean;
  5.  
  6. macro 'FFT [F]';
  7. begin
  8.             fft('foreward');
  9. end;
  10.  
  11.  
  12. macro 'Abitrary Selection FFT [A]';
  13. var
  14.    pid1, pid2, x, y, w,h, size: integer;
  15.    scale: real;
  16. begin
  17.    GetRoi(x, y, w, h);
  18.    if w = y then begin
  19.       SelectAll;
  20.       GetRoi(x, y, w, h);
  21.    end;
  22.    if w > h then begin
  23.       x := x + (w - h) div 2;
  24.       w := h;
  25.        MakeRoi(x, y, w, hª);
  26.    end;
  27.    if h > w then begin
  28.       y := y+ (h - w) div 2;
  29.       h := w;
  30.        MakeRoi(x, y, w, h);
  31.    end;
  32.    size := 2048;
  33.    if w <= 32 then size := 32
  34.    else if w <= 64 then size := 64
  35.    else if w <= 128 then size := 128
  36.    else if w <= 256 then size := 256
  37.    else if w <= 512 then size := 512
  38.    else if w <= 1024 then size := 1024;
  39.    scale := size / w;
  40.    SetScaling('Bilinear; New Window');
  41.    ScaleAndRotate(scale, scale, 0);
  42.    pid1 := pidNumber;
  43.             fft('foreward');
  44.    pid2 := pidNumber;
  45.    SelectPic(pid1);
  46.    dispose;
  47.    SelectPic(pid2);
  48. end;
  49.  
  50.  
  51. macro 'Inverse FFT [I]';
  52. begin
  53.             fft('Inverse');
  54. end;
  55.  
  56.  
  57. macro 'Inverse FFT with Custom Mask [M]';
  58. var
  59.    w,h, pixWidth, i, nSmooths: integer;
  60. begin
  61.    GetPicSize(w, h);
  62.    GetHistogram(0, 0, w,h);
  63.    if (histogram[0] = 0) and (histogram[255] = 0) then begin
  64.        PutMessage('No mask. You need to edit the power spectrum using black to pass frequencies or white to filter freqwencies.');
  65.        exit;
  66.    end;
  67.    pixWidth := GetNumber('Transition Width in Pixels:', 6, 0);
  68.    nSmooths := pixWidth div 2;
  69.    if histogram[0] <> 0 then
  70.        ChangeValues(1, 255, 255)
  71.    else
  72.        ChangeValues(0, 254, 0);
  73.    for i := 1 to nSmooths do
  74.       filter('smooth more');
  75.             fft('Inverse with Filter');
  76. end;
  77.  
  78. macro 'Inverse FFT with Filter';
  79. begin
  80.             fft('Inverse with Filter');
  81. end;
  82.  
  83. {
  84. procedure fftFilter(type: string; percent: integer);
  85. var
  86.    width, height, size, loc: integer;
  87. begin
  88.    if percent < 0 then
  89.       percent := 0;
  90.    if percent > 100 then
  91.       percent := 100;
  92.    SaveState;
  93.             fft('foreward');
  94.    GetPicSize(width, height);
  95.    size := round(( percent/100) * width);
  96.    loc := width div 2 - size/2;
  97.    MakeOvalRoi(loc, loc, size, size);
  98.    if type = 'high' then
  99.       SetForeground(0)
  100.    else
  101.       SetForeground(255);
  102.    Fill;
  103.             fft('Inverse');
  104.    RestoreState;
  105. end;
  106.  
  107.  
  108. macro 'High Pass Filter... [H]';
  109. var
  110.    percent: integer;
  111. begin
  112.    percent := GetNumber('Filter size (0-100%):', 10, 0);
  113.    fftFilter('high', percent);
  114. end;
  115.  
  116. macro 'Low Pass Filter... [L]';
  117. var
  118.    percent: integer;
  119. begin
  120.    percent := GetNumber('Filter size (0-100%):', 20, 0);
  121.    fftFilter('low', percent);
  122. end;
  123. }
  124.  
  125.  
  126. procedure MakeFilter(size, tWidth, min, max: real);
  127. var
  128.    width, height, roiSize: integer;
  129.    pixWidth, i, loc, v: integer;
  130. begin
  131.    SaveState;
  132.    if size > 100 then size := 100;
  133.    if size < 0 then size := 0;
  134.    if tWidth > 100 then tWidth := 100;
  135.    if tWidth < 0 then tWidth := 0;
  136.    if min > 100 then min := 100;
  137.    if min < 0 then min := 0;
  138.    if max > 100 then max := 100;
  139.    if max < 0 then max := 0;
  140.    if min > max then min := max;
  141.    GetPicSize(width, height);
  142.    SelectAll;
  143.    size := round(size / 100 * width);
  144.    min := round(min / 100 * 255);
  145.    max := round(max / 100 * 255);
  146.    Setbackground(min);
  147.    Clear;
  148.     roiSize := size;
  149.     pixWidth := round(size div 2 * (tWidth/100));
  150.     if pixWidth < 1 then
  151.        pixWidth := 1;
  152.     for i := 1 to pixWidth do begin
  153.        loc := width div 2 - roiSize/2;
  154.        MakeOvalRoi(loc, loc, roiSize, roiSize);
  155.        v := (max-min)  *  exp(-4.5 *  sqr(1 - i  / pixWidth)) + min; {gaussian shape}
  156.        SetForeground(v);
  157.        Fill;
  158.        roiSize := roiSize - 2;
  159.    end;
  160.    KillRoi;
  161.    RestoreState;
  162. end;
  163.  
  164.  
  165. procedure doFilter(filterType: string);
  166. var
  167.    width, height: integer;
  168. begin
  169.    if FilterSize = 0 then
  170.       FilterSize := 20;
  171.    if TransitionWidth = 0 then
  172.       TransitionWidth := 50;
  173.    FilterSize := GetNumber('Filter size (0-100%):', FilterSize, 0);
  174.    TransitionWidth := GetNumber('Transition Width (0-100%):', TransitionWidth, 0);
  175.    if TransitionWidth = 0 then
  176.       TransitionWidth := 0.0001;
  177.             fft('foreward');
  178.    MakeFilter(FilterSize, TransitionWidth, 0, 100);
  179.    if FilterType = 'high' then
  180.       Invert;
  181.    if PlotFilter then begin
  182.       getPicSize(width, height);
  183.       MakeLineRoi(0, height / 2, width, height / 2);
  184.       PlotProfile;
  185.       KillRoi;
  186.    end;
  187.    fft('Inverse with Filter');
  188. end;
  189.  
  190.  
  191. macro '(---'; begin end;
  192.  
  193.  
  194. macro 'High Pass Filter... [H]';
  195. begin
  196.   doFilter('high');
  197. end;
  198.  
  199. macro 'Low Pass Filter... [L]';
  200. begin
  201.   doFilter('low');
  202. end;
  203.  
  204. macro 'Toggle Filter Plotting ... [T]';
  205. begin
  206.   if PlotFilter then begin
  207.       PlotFilter := false;
  208.       PutMessage('Filter profiles will not be plotted.');
  209.   end else begin
  210.       PlotFilter := true;
  211.       PutMessage('Filter profiles will  be plotted.');
  212.   end;
  213. end;
  214.  
  215.  
  216. macro '(---'; begin end;
  217.  
  218.  
  219. macro 'Autocorrelation';
  220. var
  221.    fft1, fft2: integer;
  222. begin
  223.             fft('foreward');
  224.    fft1 := pidNumber;
  225.    ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
  226.    fft2 := pidNumber;
  227.    SelectPic(fft1);
  228.    Dispose;
  229.    SelectPic(fft2);
  230.             fft('Inverse');
  231.    fft('Swap Quadrants');
  232.   SetPicName('Autocorrelation')
  233. end;
  234.  
  235.  
  236. macro 'Autocorrelation with Padding';
  237. var
  238.    pad, fft1, fft2: integer;
  239.    width, height: integer;
  240.    n,mean,mode,min,max: real;
  241. begin
  242.    SelectAll;
  243.     Measure;
  244.    GetResults(n,mean,mode,min,max);
  245.    Copy;
  246.    GetPicSize(width, height);
  247.    SetNewSize(width * 2, height * 2);
  248.    Setbackgrount(round(mean));
  249.    MakeNewWindow('Padded Image');
  250.    MakeRoi(0, 0, width, height);
  251.    Paste;
  252.    KillRoi;
  253.    pad := pidNumber;
  254.             fft('foreward');
  255.    fft1 := pidNumber;
  256.    ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
  257.    fft2 := pidNumber;
  258.    SelectPic(pad);
  259.    Dispose;
  260.    SelectPic(fft1);
  261.    Dispose;
  262.    SelectPic(fft2);
  263.             fft('Inverse');
  264.    fft('Swap Quadrants');
  265.   SetPicName('Autocorrelation')
  266. end;
  267.  
  268.  
  269. macro '(---'; begin end;
  270.  
  271. macro 'Make Filter...';
  272. var
  273.    width, height: integer;
  274. begin
  275.    if FilterSize = 0 then
  276.       FilterSize := 20;
  277.    if TransitionWidth = 0 then
  278.       TransitionWidth := 50;
  279.    FilterSize := GetNumber('Filter size (0-100%):', FilterSize, 0);
  280.    TransitionWidth := GetNumber('Transition Width (0-100%):', TransitionWidth, 0);
  281.    if TransitionWidth = 0 then
  282.       TransitionWidth := 0.0001;
  283.             Duplicate('Filter');
  284.    MakeFilter(FilterSize, TransitionWidth, 0, 100);
  285. end;
  286.  
  287.  
  288. macro 'Redisplay Power Spectrum';
  289. begin
  290.    fft('Display Power Spectrum');
  291. end;
  292.  
  293. macro 'Swap Quadrants';
  294. begin
  295.    fft('Swap Quadrants');
  296. end;
  297.  
  298.  
  299. macro '(---'; begin end;
  300.  
  301.  
  302. procedure roi(size: integer);
  303. var
  304.   width, height: integer;
  305. begin
  306.   GetPicSize(width, height);
  307.   if size > width then
  308.      size := width;
  309.   if width = 0 then begin
  310.      PutMessage('No image window open.');
  311.      exit;
  312.   end;
  313.    MakeRoi(width/2 - size/2, height/2 - size/2, size, size);
  314. end;
  315.  
  316. macro 'Create 32 x 32 selection [1]'; begin roi(32) end;
  317. macro 'Create 64 x 64 selection [2]'; begin roi(64) end;
  318. macro 'Create 128 x 128 selection [3]'; begin roi(128) end;
  319. macro 'Create 256 x 256 selection [4]'; begin roi(256) end;
  320. macro 'Create 512 x 512 selection [5]'; begin roi(512) end;
  321.  
  322.  
  323.  
  324.  
  325.  
  326.